home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / pcgames.arc / DRAW.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-12-30  |  8.1 KB  |  288 lines
  1. 1  'update 8/30/82 11:00 am
  2. 10  SCREEN 0,0,0:WIDTH 80:KEY OFF:DEF SEG:POKE 106,0
  3. 15  DEF SEG=&H40:POKE &H17,(PEEK(&H17) AND 64)
  4. 20  IF FRE(0)<15000 THEN 2240
  5. 30  CLEAR:CLEAR ,28000:ON KEY(10) GOSUB 10000:KEY(10) ON
  6. 40  DEF SEG=&HE00
  7. 50  BLOAD"DRAW.EXE",0
  8. 60  DEFSTR Z
  9. 70  ON ERROR GOTO 1150
  10. 80  CLS:DIM NAMES$(1)
  11. 85  LOCATE 14,35:FILES"menu.bas"
  12. 86  GOTO 200
  13. 90  LOCATE 5,22:PRINT "You Must Use A Data  Diskette With This
  14. 100  LOCATE 6,22:PRINT "Program. Insert A Formatted Diskette In
  15. 110  LOCATE 7,22:PRINT"Drive A and  Strike Any Key To Continue
  16. 115  LOCATE 25,25:COLOR 0,7:PRINT " Strike <F10> To Return To Menu ";:COLOR 7,0
  17. 120  A$=INKEY$:IF A$="" THEN 120
  18. 130  LOCATE 14,35:FILES"MENU.BAS"
  19. 140  IF F THEN 170
  20. 150  CLS:LOCATE 5,26:COLOR 31,0:PRINT "You MUST Use A Data Diskette":COLOR 3,0
  21. 160  FOR A=1 TO 4000:NEXT :CLS:GOTO 90
  22. 170  DEF SEG=&HE00
  23. 180  BSAVE "DRAW.EXE",0,200
  24. 190  SAVE"DRAW.BAS",P
  25. 200  ON KEY(1) GOSUB 1950
  26. 210  ON KEY(2) GOSUB 2190
  27. 220  ON KEY(3) GOSUB 1930
  28. 230  ON KEY(4) GOSUB 1940
  29. 240  ON KEY(5) GOSUB 2150
  30. 250  ON KEY(6) GOSUB 2780
  31. 260  ON KEY(7) GOSUB 2180
  32. 270  ON KEY(8) GOSUB 2180
  33. 280  ON KEY(9) GOSUB 2180
  34. 290  ON KEY(10) GOSUB 2690
  35. 300  DEF SEG=0
  36. 310  IF (PEEK(&H410) AND 48)=48 THEN SEGMENT=&HB000 ELSE SEGMENT=&HB800
  37. 320  CLOSE:OPEN "PICTURE.FLE" FOR APPEND AS #1:CLOSE
  38. 330  LOCATE ,,1,5,7
  39. 340  GOSUB 2280
  40. 350  COLOR 7,0
  41. 360  GOSUB 830
  42. 370  GOSUB 720
  43. 380  DEF SEG=&HE00
  44. 390  CODE=0
  45. 400  CALL CODE
  46. 410  X=12:Y=40:LOCATE X,Y,1
  47. 420  FOR SS=1 TO 10:KEY(SS) ON:NEXT
  48. 430  DEF SEG:POKE 106,0
  49. 440  Z=INKEY$:IF Z="" THEN 420
  50. 450  Z1=MID$(Z,2,1):IF LEN(Z)>1 THEN 520
  51. 460  IF FLAG THEN PRINT Z;:Y=Y+1:GOSUB 970:GOTO 420
  52. 470  IF Z=CHR$(32) THEN PRINT " ";:Y=Y+1:GOSUB 970:GOTO 420
  53. 480  IF Z<"A" OR Z>"Y" THEN 500
  54. 490  LOCATE X,Y:PRINT CHR$(ARRAY%(1,ASC(Z)-64));:Y=Y+1:GOSUB 970:GOTO 420
  55. 500  IF Z<"a" OR Z>"y" THEN 520
  56. 510  LOCATE X,Y:PRINT CHR$(ARRAY%(0,ASC(Z)-96));:Y=Y+1:GOSUB 970:GOTO 420
  57. 520  IF Z1=CHR$(72) THEN X=X-1
  58. 530  IF Z1=CHR$(75) THEN Y=Y-1
  59. 540  IF Z1=CHR$(77) THEN Y=Y+1
  60. 550  IF Z1=CHR$(80) THEN X=X+1
  61. 560  IF Z1=CHR$(115) THEN Y=Y-10
  62. 570  IF Z1=CHR$(116) THEN Y=Y+10
  63. 580  IF Z1=CHR$(73) THEN X=X-5
  64. 590  IF Z1=CHR$(81) THEN X=X+5
  65. 600  IF Z1=CHR$(71) THEN X=1:Y=1
  66. 610  IF Z1=CHR$(79) THEN Y=80
  67. 620  IF Z1=CHR$(119) THEN GOSUB 2330:CLS:LOCATE 12,40,1:X=CSRLIN:Y=POS(0):            GOSUB 830:GOSUB 720
  68. 630  IF Z1=CHR$(31) THEN GOSUB 1420:IF FLAG THEN GOSUB 790 ELSE GOSUB 720
  69. 640  IF Z1=CHR$(38) THEN GOSUB 1610:IF FLAG THEN GOSUB 790 ELSE GOSUB 720
  70. 650  IF Z1=CHR$(37) THEN GOSUB 2360
  71. 660  IF Z1=CHR$(33) THEN GOSUB 890
  72. 670  IF Z1=CHR$(46) THEN GOSUB 1020
  73. 680  IF Z1=CHR$(118) THEN GOSUB 790
  74. 690  IF Z1=CHR$(132) THEN GOSUB 720
  75. 700  IF Z=CHR$(8) THEN PRINT CHR$(29)" "CHR$(29);:Y=Y-1
  76. 710  GOSUB 970:LOCATE X,Y,1:GOTO 420
  77. 720  LOCATE 23,1:PRINT SPC(79);:LOCATE 23,1:PRINT "UPPER"CHR$(29);
  78. 730  FOR A=1 TO 25:LOCATE ,POS(0)+2:PRINT CHR$(ARRAY%(1,A));:NEXT
  79. 740  LOCATE 24,1:PRINT SPC(79);:LOCATE 24,5
  80. 750  FOR A=1 TO 25:LOCATE ,POS(0)+2:PRINT CHR$(A+64);:NEXT
  81. 760  LOCATE 25,1:PRINT SPC(79);:LOCATE 25,1:PRINT "LOWER"CHR$(29);
  82. 770  FOR A=1 TO 25:LOCATE ,POS(0)+2:PRINT CHR$(ARRAY%(0,A));:NEXT
  83. 780  FLAG=0:RETURN
  84. 790  LOCATE 23,1:PRINT SPC(79);
  85. 800  LOCATE 24,1:PRINT SPC(79);
  86. 810  LOCATE 25,1:PRINT SPC(79);
  87. 820  LOCATE 25,22:PRINT "You Are In AlphaNumeric Character Set";:FLAG=1:RETURN
  88. 830  CLS:COLOR 0,7
  89. 840  LOCATE 1,1:PRINT " <F1> Instructions And Picture Files           <F4> Saves This Picture  To Disk "
  90. 850  LOCATE 2,1:PRINT " <F2> Runs Previous Picture (memory)           <F5> Alternates Graphics/Letters "
  91. 860  LOCATE 3,1:PRINT " <F3> Loads a Picture From Disk    <F6> Clear Screen   <F10> Leave This Program "
  92. 870  COLOR 7,0
  93. 880  RETURN
  94. 890  F=0
  95. 900  LOCATE ,1
  96. 910  CLOSE:OPEN "I",1,"PICTURE.FLE"
  97. 920  WHILE EOF(1)=0
  98. 930   INPUT#1,ZA:PRINT LEFT$(ZA,8),
  99. 940  WEND
  100. 950  CLOSE
  101. 960  RETURN
  102. 970  IF X>22 THEN X=22
  103. 980  IF X<4 THEN X=4
  104. 990  IF Y>80 THEN IF X<22 THEN X=X+1:Y=Y-80:GOTO 1010 ELSE Y=80:GOTO 1010
  105. 1000  IF Y<1 THEN IF X>4 THEN X=X-1:Y=Y+80:GOTO 1010 ELSE Y=1:GOTO 1010
  106. 1010  RETURN
  107. 1020  LOCATE 25,1:PRINT SPC(79);
  108. 1030  LOCATE 24,1:PRINT SPC(79);
  109. 1040  LOCATE 23,1:PRINT SPC(79);
  110. 1050  LOCATE 25,1:PRINT "WHAT COLORS WOULD YOU LIKE? <No,No>";
  111. 1060  Z1="":Z=""
  112. 1070  Z1=INKEY$:IF Z1="" THEN 1070
  113. 1080  IF Z1="," THEN F=VAL(Z):PRINT ",";:GOTO 1060
  114. 1090  IF Z1=CHR$(13) THEN 1140
  115. 1100  IF MID$(Z1,2,1)=CHR$(75) THEN 1130
  116. 1110  IF Z1=CHR$(8) THEN 1130
  117. 1120  Z=Z+Z1:PRINT Z1;:GOTO 1070
  118. 1130  IF LEN(Z)<1 THEN 1070 ELSE PRINT CHR$(29)" "CHR$(29);:Z=LEFT$(Z,LEN(Z)-1):GOTO 1070
  119. 1140  F1=VAL(Z):GOSUB 720:COLOR F,F1:RETURN
  120. 1150  IF ERR=61 THEN ER$="Diskette Is Full":GOTO 1330
  121. 1160  IF ERR=53 AND ERL=1910 THEN ER$="Insert A FriendlyWare Diskette":GOTO 1280
  122. 1170  IF ERR=53 AND (ERL=130 OR ERL=85) THEN F=1:RESUME NEXT
  123. 1180  IF ERR=53 THEN ER$="File Was Not Found":GOTO 1330
  124. 1190  IF ERR=64 THEN ER$="Bad File Name":GOTO 1330
  125. 1200  IF ERR=67 THEN ER$="Too Many Diskette Files":GOTO 1330
  126. 1210  IF ERR=70 THEN ER$="Diskette Is Write Protected":GOTO 1330
  127. 1220  IF ERR=71 THEN ER$="Close Disk Drive Cover":GOTO 1330
  128. 1230  IF ERR=72 THEN ER$="Disk Media Error":GOTO 1330
  129. 1240  IF ERR=52 THEN ER$="Bad File Name":GOTO 1330
  130. 1250  IF ERR=3 AND ERL=1410 THEN RESUME 180
  131. 1260  ON ERROR GOTO 0
  132. 1270  END
  133. 1280  LOCATE 24,1:PRINT SPC(79);
  134. 1290  LOCATE 23,1:PRINT SPC(79);
  135. 1300  LOCATE 24,30:PRINT ER$;
  136. 1310  LOCATE 25,1:PRINT SPC(79);
  137. 1320  LOCATE 25,30:PRINT "And Strike Any Key To Continue";
  138. 1321  DEF SEG:POKE 106,0:IF INKEY$<>"" THEN 1321
  139. 1322  Z=INKEY$:IF Z="" THEN 1322 ELSE RESUME 1910
  140. 1330  LOCATE 24,1:PRINT SPC(79);
  141. 1340  LOCATE 24,30:PRINT ER$;
  142. 1350  LOCATE 25,1:PRINT SPC(79);
  143. 1360  LOCATE 25,15:PRINT "Your Command Was Aborted. Strike Any Key To Try Again.";
  144. 1370  DEF SEG:POKE 106,0:IF INKEY$<>"" THEN 1370 ELSE DEF SEG=SEGMENT
  145. 1380  Z=INKEY$:IF Z="" THEN 1370
  146. 1390  F=1
  147. 1400  RESUME 1410
  148. 1410  RETURN
  149. 1420  'SAVE A SCREEN
  150. 1430  GOSUB 2330
  151. 1440  LOCATE 23,1:PRINT SPC(79);
  152. 1450  LOCATE 24,1:PRINT SPC(79);
  153. 1460  LOCATE 25,1:PRINT SPC(79);
  154. 1470  LOCATE 24,10:PRINT "And Then Strike The Enter Key ";
  155. 1480  LOCATE 23,10:PRINT "Please Enter A Name For This Picture ";
  156. 1490  GOSUB 1770:IF ZA="        " THEN 1440
  157. 1500  KEEP$=ZA+".pic
  158. 1510  DEF SEG=SEGMENT
  159. 1520  BSAVE KEEP$,480,3040
  160. 1530  CLOSE:OPEN "PICTURE.FLE" FOR INPUT AS #1
  161. 1540  WHILE EOF(1)=0
  162. 1550    INPUT#1,ZA
  163. 1560    IF KEEP$=ZA THEN 1600
  164. 1570  WEND
  165. 1580  CLOSE:OPEN "PICTURE.FLE" FOR APPEND AS #1
  166. 1590  WRITE#1,KEEP$
  167. 1600  CLOSE:GOSUB 830:RETURN
  168. 1610  GOSUB 2330
  169. 1620  LOCATE 25,1:PRINT SPC(79);
  170. 1630  LOCATE 24,1:PRINT SPC(79);
  171. 1640  LOCATE 23,1:PRINT SPC(79);
  172. 1650  CLS:GOSUB 830:LOCATE 4,1
  173. 1660  CLOSE:OPEN "I",1,"PICTURE.FLE"
  174. 1670  WHILE EOF(1)=0
  175. 1680    INPUT#1,LO$:PRINT LEFT$(LO$,8),
  176. 1690  WEND
  177. 1700  LOCATE 24,10:PRINT "And Then Strike The Enter Key ";
  178. 1710  LOCATE 23,10:PRINT "Please Enter The Name Of The Picture You'd Like To See ";
  179. 1720  GOSUB 1770
  180. 1730  KEEP$=ZA+".pic"
  181. 1740  DEF SEG=SEGMENT
  182. 1750  BLOAD KEEP$,480
  183. 1760  RETURN
  184. 1770  ZH=""
  185. 1780  DEF SEG:POKE 106,0:IF INKEY$<>"" THEN 1780
  186. 1790  ZI=INKEY$:IF ZI="" THEN 1790
  187. 1800  IF ZI=CHR$(13) THEN ZA=SPACE$(8):LSET ZA=ZH:RETURN
  188. 1810  IF ZI=CHR$(8) THEN 1870
  189. 1820  IF LEN(ZI)>1 THEN IF RIGHT$(ZI,1)=CHR$(75) THEN 1870 ELSE 1780
  190. 1830  IF LEN(ZH)>7 THEN 1790
  191. 1840  IF ZI<"a" OR ZI>"z" THEN 1860
  192. 1850  ZI=CHR$(ASC(ZI)-32)
  193. 1860  ZH=ZH+ZI:PRINT ZI;:GOTO 1790
  194. 1870  IF LEN(ZH)<1 THEN 1790
  195. 1880  PRINT CHR$(29)" "CHR$(29);:ZH=LEFT$(ZH,LEN(ZH)-1):GOTO 1790
  196. 1890  GOSUB 1900
  197. 1900  IF F=1 THEN F=0:GOTO 1890
  198. 1910  CLEAR ,36000:ON ERROR GOTO 1150:DEFSTR Z:RUN"menu
  199. 1920  KEY(1) OFF:KEY(3) OFF:KEY(4) OFF:Z=CHR$(0)+CHR$(33):RETURN 450
  200. 1930  FOR A=2 TO 10:KEY(A) OFF:NEXT:Z=CHR$(0)+CHR$(38):RETURN 450
  201. 1940  FOR A=2 TO 10:KEY(A) OFF:NEXT:Z=CHR$(0)+CHR$(31):RETURN 450
  202. 1950  FOR A=2 TO 10:KEY(A) OFF:NEXT:DEF SEG=SEGMENT
  203. 1960  BSAVE "tempory.tmp",480,3040
  204. 1970  CLS
  205. 1980  LOCATE 1,18:PRINT"          DRAW COMMANDS and CONTROLS
  206. 1990  LOCATE 2,18:PRINT"Alt & K.............To Erase A Picture From Files
  207. 2000  LOCATE 3,18:PRINT"Cursor Arrows.......Moves Cursor In Any Direction
  208. 2010  LOCATE 4,18:PRINT"Ctrl & Arrow Left...Moves Cursor Left  10  spaces
  209. 2020  LOCATE 5,18:PRINT"Ctrl & Arrow Right..Moves Cursor Right 10  spaces
  210. 2030  LOCATE 6,18:PRINT"PgUp................Moves Cursor  Up    5   Lines
  211. 2040  LOCATE 7,18:PRINT"PgDn................Moves Cursor Down   5   Lines
  212. 2050  LOCATE 8,18:PRINT"End.................Moves Cursor To End  Of  Line
  213. 2060  LOCATE 9,18:PRINT"Home................Moves Cursor Home, Upper Left
  214. 2070  LOCATE 10,18:PRINT"Alt & C.............Color Command, Enter No. , No.
  215. 2071  LOCATE 11,18:PRINT"(The First Is Foreground And Second Is Background)
  216. 2080  LOCATE 13,18:PRINT"The Following Names Are Pictures On This Diskette:
  217. 2090  LOCATE 15,1:GOSUB 890
  218. 2100  LOCATE 25,27:PRINT "Strike Any Key To Continue";
  219. 2110  A$=INKEY$:IF A$="" THEN 2110
  220. 2120  GOSUB 830:GOSUB 720
  221. 2130  DEF SEG=SEGMENT:BLOAD "tempory.tmp",480
  222. 2140  LOCATE X,Y,1:RETURN
  223. 2150  FOR A=1 TO 10:KEY(A) OFF:NEXT
  224. 2160  IF FLAG THEN GOSUB 720 ELSE GOSUB 790
  225. 2170  FOR A=1 TO 10:KEY(A) ON:NEXT:LOCATE X,Y,1:RETURN
  226. 2180  RETURN
  227. 2190  CLS
  228. 2200  DEF SEG=&HE00
  229. 2210  CODE=&H40
  230. 2220  CALL CODE
  231. 2230  LOCATE X,Y:RETURN
  232. 2240  CLS
  233. 2250  LOCATE 4,20:PRINT"Sorry But You Must Have At Least 64K Of Memory
  234. 2260  LOCATE 5,20:PRINT "           To Use This Program"
  235. 2270  FOR A=1 TO 5000:NEXT:GOSUB 1890:GOTO 2270
  236. 2280  DIM ARRAY%(1,25)
  237. 2290  FOR A=0 TO 1:FOR B=1 TO 25:READ ARRAY%(A,B):NEXT:NEXT
  238. 2300  RETURN
  239. 2310  DATA 200,188,186,202,185,197,192,217,179,193,180,177,176,221,220,17,27,174,25,249,250,157,4,5,2
  240. 2320  DATA 201,187,205,203,204,206,218,191,196,194,195,219,178,222,223,16,26,175,24,15,248,247,6,3,1
  241. 2330  DEF SEG=&HE00
  242. 2340  CODE=0
  243. 2350  CALL CODE:RETURN
  244. 2360  FOR A=1 TO 9:KEY(A) OFF:NEXT
  245. 2370  GOSUB 2330:CLS:GOSUB 830:LOCATE 5,1
  246. 2380  CLOSE:OPEN "picture.fle" FOR INPUT AS #1
  247. 2390  ERASE NAMES$:DIM NAMES$(50)
  248. 2400  A=0
  249. 2410  WHILE EOF(1)=0
  250. 2420   INPUT#1,NAMES$(A):PRINT LEFT$(NAMES$(A),8)"  ";:A=A+1
  251. 2430  WEND
  252. 2440  LOCATE 23,1:PRINT SPC(79);
  253. 2450  LOCATE 24,1:PRINT SPC(79);
  254. 2460  LOCATE 25,1:PRINT SPC(79);
  255. 2470  LOCATE 24,10:PRINT "And Then Strike The Enter Key ";
  256. 2480  LOCATE 23,10:PRINT "Please Enter Name Of Picture That You Wish To Erase ";
  257. 2490  GOSUB 1770:B=0
  258. 2500  WHILE B<>A
  259. 2510   IF ZA=LEFT$(NAMES$(B),8) THEN 2590
  260. 2520   B=B+1
  261. 2530  WEND
  262. 2540  LOCATE 23,1:PRINT SPC(79);
  263. 2550  LOCATE 24,1:PRINT SPC(79);
  264. 2560  LOCATE 25,1:PRINT SPC(79);
  265. 2570  LOCATE 23,10:PRINT "No Such File Name. ";:
  266. 2580  FOR A=1 TO 4000:NEXT:GOTO 2670
  267. 2590  KILL NAMES$(B)
  268. 2600  NAMES$(B)=""
  269. 2610  CLOSE:OPEN "picture.fle" FOR OUTPUT AS #1
  270. 2620  B=0
  271. 2630  WHILE B<>A
  272. 2640   IF NAMES$(B)<>"" THEN WRITE#1,NAMES$(B)
  273. 2650   B=B+1
  274. 2660  WEND
  275. 2670  IF FLAG THEN GOSUB 790 ELSE GOSUB 720
  276. 2680  GOSUB 2190:FOR A=1 TO 9:KEY(A) ON:NEXT:RETURN
  277. 2690  FOR A=1 TO 10:KEY(A) OFF:NEXT
  278. 2700  XLIN=CSRLIN:XPOS=POS(0):LOCATE 25,1:PRINT SPC(79);
  279. 2710  LOCATE 25,21:PRINT "Do You Wish To Leave This Program? <Y/N>";
  280. 2720  Z=INKEY$:IF Z="" THEN 2720
  281. 2730  IF Z="y" OR Z="Y" THEN 2770
  282. 2740  IF Z<>"n" AND Z<>"N" THEN 2720
  283. 2750  IF FLAG THEN GOSUB 790 ELSE GOSUB 720
  284. 2760  FOR A=1 TO 10:KEY(A) ON:NEXT:RETURN
  285. 2770  RETURN 1890
  286. 2780  FOR A=1 TO 9:KEY(A) OFF:NEXT:Z=CHR$(0)+CHR$(119):RETURN 450
  287. 10000  CLEAR ,36000:RUN"menu
  288.